home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb30.arc / PIBASYNC.PAS < prev    next >
Pascal/Delphi Source File  |  1985-06-04  |  50KB  |  1,073 lines
  1. (*----------------------------------------------------------------------*)
  2. (*         PIBASYNC.PAS   --- Asynchronous I/O for Turbo Pascal         *)
  3. (*----------------------------------------------------------------------*)
  4. (*                                                                      *)
  5. (*  Author:  Philip R. Burns                                            *)
  6. (*  Date:    January, 1985                                              *)
  7. (*  Version: 1.0                                                        *)
  8. (*  Systems: For MS-DOS on IBM PCs and close compatibles only.          *)
  9. (*           Note:  I have checked these on Zenith 151s under           *)
  10. (*                  MSDOS 2.1 and IBM PCs under PCDOS 2.0.              *)
  11. (*                                                                      *)
  12. (*  History: Some of these routines are based upon ones written by:     *)
  13. (*                                                                      *)
  14. (*              Alan Bishop                                             *)
  15. (*              C. J. Dunford                                           *)
  16. (*              Michael Quinlan                                         *)
  17. (*                                                                      *)
  18. (*           I have cleaned up these other authors' code, fixed some    *)
  19. (*           bugs, and added many new features.                         *)
  20. (*                                                                      *)
  21. (*           Suggestions for improvements or corrections are welcome.   *)
  22. (*           Please leave messages on Gene Plantz's BBS (312) 882 4145  *)
  23. (*           or Ron Fox's BBS (312) 940 6496.                           *)
  24. (*                                                                      *)
  25. (*           If you use this code in your own programs, please be nice  *)
  26. (*           and give all of us credit.                                 *)
  27. (*                                                                      *)
  28. (*----------------------------------------------------------------------*)
  29. (*                                                                      *)
  30. (*  Routines:                                                           *)
  31. (*                                                                      *)
  32. (*     Async_Init             ---    Performs initialization.           *)
  33. (*     Async_Open             ---    Sets up COM port                   *)
  34. (*     Async_Close            ---    Closes down COM port               *)
  35. (*     Async_Carrier_Detect   ---    Checks for modem carrier detect    *)
  36. (*     Async_Carrier_Drop     ---    Checks for modem carrier drop      *)
  37. (*     Async_Buffer_Check     ---    Checks if character in COM buffer  *)
  38. (*     Async_Term_Ready       ---    Toggles terminal ready status      *)
  39. (*     Async_Receive          ---    Reads character from COM buffer    *)
  40. (*     Async_Receive_With_Timeout                                       *)
  41. (*                            ---    Receives char. with timeout check  *)
  42. (*     Async_Send             ---    Transmits char over COM port       *)
  43. (*     Async_Send_String      ---    Sends string over COM port         *)
  44. (*     Async_Send_String_With_Delays                                    *)
  45. (*                            ---    Sends string with timed delays     *)
  46. (*     Async_Send_Break       ---    Sends break (attention) signal     *)
  47. (*     Async_Percentage_Used  ---    Returns percentage com buffer used *)
  48. (*     Async_Purge_Buffer     ---    Purges receive buffer              *)
  49. (*                                                                      *)
  50. (*----------------------------------------------------------------------*)
  51. (*                                                                      *)
  52. (*----------------------------------------------------------------------*)
  53.  
  54.  
  55. (*----------------------------------------------------------------------*)
  56. (*                                                                      *)
  57. (*                  COMMUNICATIONS HARDWARE ADDRESSES                   *)
  58. (*                                                                      *)
  59. (*        These are specific to IBM PCs and close compatibles.          *)
  60. (*                                                                      *)
  61. (*----------------------------------------------------------------------*)
  62.  
  63. Const
  64.  
  65.    UART_THR = $00;       (* offset from base of UART Registers for IBM PC *)
  66.    UART_RBR = $00;
  67.    UART_IER = $01;
  68.    UART_IIR = $02;
  69.    UART_LCR = $03;
  70.    UART_MCR = $04;
  71.    UART_LSR = $05;
  72.    UART_MSR = $06;
  73.  
  74.    I8088_IMR = $21;      (* port address of the Interrupt Mask Register *)
  75.  
  76.    COM1_Base = $03F8;    (* port addresses for the UART *)
  77.    COM2_Base = $02F8;
  78.  
  79.    COM1_Irq = 4;         (* Interrupt line for the UART *)
  80.    COM2_Irq = 3;
  81.  
  82. Const
  83.  
  84.    Async_DSeg_Save : Integer = 0;  (* Save DS reg in Code Segment for *)
  85.                                    (* interrupt routine               *)
  86.  
  87. (*----------------------------------------------------------------------*)
  88. (*                                                                      *)
  89. (*                   COMMUNICATIONS BUFFER VARIABLES                    *)
  90. (*                                                                      *)
  91. (*     The Communications Buffer is implemented as a circular (ring)    *)
  92. (*     buffer, or double-ended queue.  The asynchronous I/O routines    *)
  93. (*     enter characters in the buffer as they are received.  Higher-    *)
  94. (*     level routines may extract characters from the buffer.           *)
  95. (*                                                                      *)
  96. (*     Note that this buffer is used for input only;  output is done    *)
  97. (*     on a character-by-character basis.                               *)
  98. (*                                                                      *)
  99. (*----------------------------------------------------------------------*)
  100.  
  101. Const
  102.  
  103.    Async_Buffer_Max    = 8191;       (* Size of Communications Buffer   *)
  104.    Async_Loops_Per_Sec = 6500;       (* Loops per second -- 4.77 clock  *)
  105.    TimeOut             = 256;        (* TimeOut value                   *)
  106.  
  107. Var
  108.                                      (* Communications Buffer Itself *)
  109.  
  110.    Async_Buffer          : Array[0..Async_Buffer_Max] of Char;
  111.  
  112.    Async_Open_Flag       : Boolean;  (* true if Open but no Close         *)
  113.    Async_Port            : Integer;  (* current Open port number (1 or 2) *)
  114.    Async_Base            : Integer;  (* base for current open port        *)
  115.    Async_Irq             : Integer;  (* irq for current open port         *)
  116.  
  117.    Async_Buffer_Overflow : Boolean;  (* True if buffer overflow has happened *)
  118.    Async_Buffer_Used     : Integer;
  119.    Async_MaxBufferUsed   : Integer;
  120.  
  121.                                      (* Async_Buffer empty if Head = Tail    *)
  122.    Async_Buffer_Head    : Integer;   (* Loc in Async_Buffer to put next char *)
  123.    Async_Buffer_Tail    : Integer;   (* Loc in Async_Buffer to get next char *)
  124.    Async_Buffer_NewTail : Integer;
  125.  
  126. (*----------------------------------------------------------------------*)
  127. (*                BIOS_RS232_Init --- Initialize UART                   *)
  128. (*----------------------------------------------------------------------*)
  129.  
  130. Procedure BIOS_RS232_Init( ComPort, ComParm : Integer );
  131.  
  132. (*                                                                      *)
  133. (*     Procedure:  BIOS_RS232_Init                                      *)
  134. (*                                                                      *)
  135. (*     Purpose:    Issues interrupt $14 to initialize the UART          *)
  136. (*                                                                      *)
  137. (*     Calling Sequence:                                                *)
  138. (*                                                                      *)
  139. (*        BIOS_RS232_Init( ComPort, ComParm : Integer );                *)
  140. (*                                                                      *)
  141. (*           ComPort  --- Communications Port Number (1 or 2)           *)
  142. (*           ComParm  --- Communications Parameter Word                 *)
  143. (*                                                                      *)
  144. (*      Calls:   INTR   (to perform BIOS interrupt $14)                 *)
  145. (*                                                                      *)
  146.  
  147. Var
  148.    Regs: RegPack;
  149.  
  150. Begin   (* BIOS_RS232_Init *)
  151.  
  152.    With Regs Do
  153.       Begin
  154.          Ax := ComParm AND $00FF;  (* AH=0; AL=ComParm   *)
  155.          Dx := ComPort;            (* Port number to use *)
  156.          INTR($14, Regs);
  157.       End;
  158.  
  159. End    (* BIOS_RS232_Init *);
  160.  
  161.  
  162. (*----------------------------------------------------------------------*)
  163. (*             DOS_Set_Intrpt --- Call DOS to set interrupt vector      *)
  164. (*----------------------------------------------------------------------*)
  165.  
  166. Procedure DOS_Set_Intrpt( v, s, o : Integer );
  167.  
  168. (*                                                                      *)
  169. (*     Procedure:  DOS_Set_Intrpt                                       *)
  170. (*                                                                      *)
  171. (*     Purpose:    Calls DOS to set interrupt vector                    *)
  172. (*                                                                      *)
  173. (*     Calling Sequence:                                                *)
  174. (*                                                                      *)
  175. (*        DOS_Set_Intrpt( v, s, o : Integer );                          *)
  176. (*                                                                      *)
  177. (*           v --- interrupt vector number to set                       *)
  178. (*           s --- segment address of interrupt routine                 *)
  179. (*           o --- offset address of interrupt routine                  *)
  180. (*                                                                      *)
  181. (*      Calls:   MSDOS   (to set interrupt)                             *)
  182. (*                                                                      *)
  183.  
  184. Var
  185.    Regs : Regpack;
  186.  
  187. Begin   (* DOS_Set_Intrpt *)
  188.  
  189.    With Regs Do
  190.       Begin
  191.          Ax := $2500 + ( v AND $00FF );
  192.          Ds := s;
  193.          Dx := o;
  194.          MsDos( Regs );
  195.       End;
  196.  
  197. End    (* DOS_Set_Intrpt *);
  198.  
  199. (*----------------------------------------------------------------------*)
  200. (*               Async_Isr --- Interrupt Service Routine                *)
  201. (*----------------------------------------------------------------------*)
  202.  
  203. Procedure Async_Isr;
  204.  
  205. (*                                                                      *)
  206. (*     Procedure:  Async_Isr                                            *)
  207. (*                                                                      *)
  208. (*     Purpose:    Invoked when UART has received character from        *)
  209. (*                 communications line  (asynchronous)                  *)
  210. (*                                                                      *)
  211. (*     Calling Sequence:                                                *)
  212. (*                                                                      *)
  213. (*        Async_Isr;                                                    *)
  214. (*                                                                      *)
  215. (*           --- Called asyncronously only!!!!!!                        *)
  216. (*                                                                      *)
  217. (*     Remarks:                                                         *)
  218. (*                                                                      *)
  219. (*        This is Michael Quinlan's version of the interrupt handler.   *)
  220. (*                                                                      *)
  221.  
  222. Begin   (* Async_Isr *)
  223.  
  224.   (*  NOTE: on entry, Turbo Pascal has already PUSHed BP and SP  *)
  225.  
  226.   Inline(
  227.       (* save all registers used *)
  228.     $50/                           (* PUSH AX *)
  229.     $53/                           (* PUSH BX *)
  230.     $52/                           (* PUSH DX *)
  231.     $1E/                           (* PUSH DS *) 
  232.     $FB/                           (* STI *)
  233.       (* set up the DS register to point to Turbo Pascal's data segment *)
  234.     $2E/$FF/$36/Async_Dseg_Save/   (* PUSH CS:Async_Dseg_Save *)
  235.     $1F/                           (* POP DS *)
  236.       (* get the incomming character *) 
  237.       (* Async_Buffer[Async_Buffer_Head] := Chr(Port[UART_RBR + Async_Base]); *) 
  238.     $8B/$16/Async_Base/            (* MOV DX,Async_Base *) 
  239.     $EC/                           (* IN AL,DX *)
  240.     $8B/$1E/Async_Buffer_Head/     (* MOV BX,Async_Buffer_Head *) 
  241.     $88/$87/Async_Buffer/          (* MOV Async_Buffer[BX],AL *)
  242.       (* Async_Buffer_NewHead := Async_Buffer_Head + 1; *)
  243.     $43/                           (* INC BX *)
  244.       (* if Async_Buffer_NewHead > Async_Buffer_Max then
  245.           Async_Buffer_NewHead := 0; *)
  246.     $81/$FB/Async_Buffer_Max/      (* CMP BX,Async_Buffer_Max *)
  247.     $7E/$02/                       (* JLE L001 *) 
  248.     $33/$DB/                       (* XOR BX,BX *)
  249.       (* if Async_Buffer_NewHead = Async_Buffer_Tail then
  250.           Async_Buffer_Overflow := TRUE
  251.         else *)
  252. (*L001:*)
  253.     $3B/$1E/Async_Buffer_Tail/     (* CMP BX,Async_Buffer_Tail *)
  254.     $75/$08/                       (* JNE L002 *) 
  255.     $C6/$06/Async_Buffer_Overflow/$01/ (* MOV Async_Buffer_Overflow,1 *)
  256.     $90/                           (* NOP generated by assembler for some reason *)
  257.     $EB/$16/                       (* JMP SHORT L003 *)
  258.       (* begin
  259.           Async_Buffer_Head := Async_Buffer_NewHead; 
  260.           Async_Buffer_Used := Async_Buffer_Used + 1; 
  261.           if Async_Buffer_Used > Async_MaxBufferUsed then 
  262.             Async_MaxBufferUsed := Async_Buffer_Used
  263.         end; *) 
  264. (*L002:*)
  265.     $89/$1E/Async_Buffer_Head/     (* MOV Async_Buffer_Head,BX *)
  266.     $FF/$06/Async_Buffer_Used/     (* INC Async_Buffer_Used *)
  267.     $8B/$1E/Async_Buffer_Used/     (* MOV BX,Async_Buffer_Used *)
  268.     $3B/$1E/Async_MaxBufferUsed/   (* CMP BX,Async_MaxBufferUsed *)
  269.     $7E/$04/                       (* JLE L003 *)
  270.     $89/$1E/Async_MaxBufferUsed/   (* MOV Async_MaxBufferUsed,BX *) 
  271. (*L003:*)
  272.       (* disable interrupts *)
  273.     $FA/                           (* CLI *)
  274.       (* Port[$20] := $20; *)  (* use non-specific EOI *)
  275.     $B0/$20/                       (* MOV AL,20h *)
  276.     $E6/$20/                       (* OUT 20h,AL *)
  277.       (* restore the registers then use IRET to return *)
  278.       (* the last two POPs are required because Turbo Pascal PUSHes these regs
  279.         before we get control.  The manual doesn't say so, but that is what
  280.         really happens *)
  281.     $1F/                           (* POP DS *)
  282.     $5A/                           (* POP DX *)
  283.     $5B/                           (* POP BX *)
  284.     $58/                           (* POP AX *)
  285.     $5C/                           (* POP SP *)
  286.     $5D/                           (* POP BP *)
  287.     $CF)                           (* IRET *)
  288.  
  289. End    (* Async_Isr *);
  290.  
  291. (*----------------------------------------------------------------------*)
  292. (*               Async_Init --- Initialize Asynchronous Variables       *)
  293. (*----------------------------------------------------------------------*)
  294.  
  295. Procedure Async_Init;
  296.  
  297. (*                                                                      *)
  298. (*     Procedure:  Async_Init                                           *)
  299. (*                                                                      *)
  300. (*     Purpose:    Initializes variables                                *)
  301. (*                                                                      *)
  302. (*     Calling Sequence:                                                *)
  303. (*                                                                      *)
  304. (*        Async_Init;                                                   *)
  305. (*                                                                      *)
  306. (*     Calls:  None                                                     *)
  307. (*                                                                      *)
  308.  
  309. Begin   (* Async_Init *)
  310.  
  311.   Async_DSeg_Save       := DSeg;
  312.   Async_Open_Flag       := FALSE;
  313.   Async_Buffer_Overflow := FALSE;
  314.   Async_Buffer_Used     := 0;
  315.   Async_MaxBufferUsed   := 0;
  316.  
  317. End     (* Async_Init *);
  318.  
  319. (*----------------------------------------------------------------------*)
  320. (*               Async_Close --- Close down communications interrupts   *)
  321. (*----------------------------------------------------------------------*)
  322.  
  323. Procedure Async_Close;
  324.  
  325. (*                                                                      *)
  326. (*     Procedure:  Async_Close                                          *)
  327. (*                                                                      *)
  328. (*     Purpose:    Resets interrupt system when UART interrupts         *)
  329. (*                 are no longer needed.                                *)
  330. (*                                                                      *)
  331. (*     Calling Sequence:                                                *)
  332. (*                                                                      *)
  333. (*        Async_Close;                                                  *)
  334. (*                                                                      *)
  335. (*     Calls:  None                                                     *)
  336. (*                                                                      *)
  337.  
  338. Var
  339.    i : Integer;
  340.    m : Integer;
  341.  
  342. Begin  (* Async_Close *)
  343.  
  344.    If Async_Open_Flag Then
  345.       Begin
  346.  
  347.                      (* disable the IRQ on the 8259 *)
  348.  
  349.          Inline($FA);                 (* disable interrupts *)
  350.  
  351.          i := Port[I8088_IMR];        (* get the interrupt mask register *)
  352.          m := 1 shl Async_Irq;        (* set mask to turn off interrupt  *)
  353.          Port[I8088_IMR] := i or m;
  354.  
  355.                      (* disable the 8250 data ready interrupt *)
  356.  
  357.          Port[UART_IER + Async_Base] := 0;
  358.  
  359.                      (* disable OUT2 on the 8250 *)
  360.  
  361.          Port[UART_MCR + Async_Base] := 0;
  362.  
  363.          Inline($FB);                 (* enable interrupts *)
  364.  
  365.                      (* re-initialize our data areas so we know *)
  366.                      (* the port is closed                      *)
  367.  
  368.          Async_Open_Flag := FALSE;
  369.  
  370.       End;
  371.  
  372. End    (* Async_Close *);
  373.  
  374. (*----------------------------------------------------------------------*)
  375. (*               Async_Open --- Open communications port                *)
  376. (*----------------------------------------------------------------------*)
  377.  
  378. Function Async_Open( ComPort       : Integer;
  379.                      BaudRate      : Integer;
  380.                      Parity        : Char;
  381.                      WordSize      : Integer;
  382.                      StopBits      : Integer  ) : Boolean;
  383.  
  384. (*                                                                      *)
  385. (*     Function:   Async_Open                                           *)
  386. (*                                                                      *)
  387. (*     Purpose:    Opens communications port                            *)
  388. (*                                                                      *)
  389. (*     Calling Sequence:                                                *)
  390. (*                                                                      *)
  391. (*        Flag := Async_Open( ComPort       : Integer;                  *)
  392. (*                            BaudRate      : Integer;                  *)
  393. (*                            Parity        : Char;                     *)
  394. (*                            WordSize      : Integer;                  *)
  395. (*                            StopBits      : Integer) : Boolean;       *)
  396. (*                                                                      *)
  397. (*           ComPort  --- which port (1 or 2)                           *)
  398. (*           BaudRate --- Baud rate (110 to 9600)                       *)
  399. (*           Parity   --- "E" for even, "O" for odd, "N" for none       *)
  400. (*           WordSize --- Bits per character  (5 through 8)             *)
  401. (*           StopBits --- How many stop bits  (1 or 2)                  *)
  402. (*                                                                      *)
  403. (*           Flag returned TRUE if port initialized successfully;       *)
  404. (*           Flag returned FALSE if any errors.                         *)
  405. (*                                                                      *)
  406. (*     Calls:                                                           *)
  407. (*                                                                      *)
  408. (*        BIOS_RS232_Init --- initialize RS232 port                     *)
  409. (*        DOS_Set_Intrpt  --- set address of RS232 interrupt routine    *)
  410. (*                                                                      *)
  411.  
  412. Const   (* Baud Rate Constants *)
  413.  
  414.    Async_Num_Bauds = 8;
  415.  
  416.    Async_Baud_Table : Array [1..Async_Num_Bauds] Of Record
  417.                                                        Baud, Bits : Integer;
  418.                                                     End
  419.  
  420.                     = ( ( Baud: 110;  Bits: $00 ),
  421.                         ( Baud: 150;  Bits: $20 ),
  422.                         ( Baud: 300;  Bits: $40 ),
  423.                         ( Baud: 600;  Bits: $60 ),
  424.                         ( Baud: 1200; Bits: $80 ),
  425.                         ( Baud: 2400; Bits: $A0 ),
  426.                         ( Baud: 4800; Bits: $C0 ),
  427.                         ( Baud: 9600; Bits: $E0 ) );
  428.  
  429. Var
  430.    ComParm : Integer;
  431.    i       : Integer;
  432.    m       : Integer;
  433.  
  434. Begin  (* Async_Open *)
  435.  
  436.                              (* If port open, close it down first. *)
  437.  
  438.    If Async_Open_Flag Then Async_Close;
  439.  
  440.                              (* Choose communications port *)
  441.    If ComPort = 2 Then
  442.       Begin
  443.          Async_Port := 2;
  444.          Async_Base := COM2_Base;
  445.          Async_Irq  := COM2_Irq;
  446.       End
  447.    Else
  448.       Begin
  449.          Async_Port := 1;  (* default to COM1 *)
  450.          Async_Base := COM1_Base;
  451.          Async_Irq  := COM1_Irq;
  452.       End;
  453.  
  454.    If (Port[UART_IIR + Async_Base] and $00F8) <> 0 Then
  455.       Async_Open := FALSE    (* Serial port not installed *)
  456.    Else
  457.       Begin   (* Open the port *)
  458.  
  459.                    (* Set buffer pointers *)
  460.  
  461.          Async_Buffer_Head     := 0;
  462.          Async_Buffer_Tail     := 0;
  463.          Async_Buffer_Overflow := FALSE;
  464.  
  465.             (*---------------------------------------------------*)
  466.             (*    Build the ComParm for RS232_Init               *)
  467.             (*    See Technical Reference Manual for description *)
  468.             (*---------------------------------------------------*)
  469.  
  470.                    (* Set up the bits for the baud rate *)
  471.  
  472.          If BaudRate > 9600 Then
  473.             BaudRate := 9600
  474.          Else If BaudRate <= 0 Then
  475.             BaudRate := 300;
  476.  
  477.          i := 0;
  478.  
  479.          Repeat
  480.             i := i + 1
  481.          Until ( ( i >= Async_Num_Bauds ) OR
  482.                  ( BaudRate = Async_Baud_Table[i].Baud ) );
  483.  
  484.          ComParm := Async_Baud_Table[i].Bits;
  485.  
  486.                    (* Choose Parity *)
  487.  
  488.          If Parity In ['E', 'e'] Then
  489.             ComParm := ComParm or $0018
  490.          Else If Parity In ['O', 'o'] Then
  491.             ComParm := ComParm or $0008;
  492.  
  493.                    (* Choose number of data bits *)
  494.  
  495.          WordSize := WordSize - 5;
  496.  
  497.          If ( WordSize < 0 ) OR ( WordSize > 3 ) Then
  498.             WordSize := 3;
  499.  
  500.          ComParm := ComParm OR WordSize;
  501.  
  502.                    (* Choose stop bits *)
  503.  
  504.          If StopBits = 2 Then
  505.             ComParm := ComParm OR $0004;  (* default is 1 stop bit *)
  506.  
  507.                    (* use the BIOS COM port initialization routine *)
  508.  
  509.          BIOS_RS232_Init( Async_Port - 1 , ComParm );
  510.  
  511.          DOS_Set_Intrpt( Async_Irq + 8 , CSeg , Ofs( Async_Isr ) );
  512.  
  513.                    (* Read the RBR and reset any pending error conditions. *)
  514.                    (* First turn off the Divisor Access Latch Bit to allow *)
  515.                    (* access to RBR, etc.                                  *)
  516.  
  517.          Inline($FA);  (* disable interrupts *)
  518.  
  519.          Port[UART_LCR + Async_Base] := Port[UART_LCR + Async_Base] and $7F;
  520.  
  521.                    (* Read the Line Status Register to reset any errors *)
  522.                    (* it indicates                                      *)
  523.  
  524.          i := Port[UART_LSR + Async_Base];
  525.  
  526.                    (* Read the Receiver Buffer Register in case it *)
  527.                    (* contains a character                         *)
  528.  
  529.          i := Port[UART_RBR + Async_Base];
  530.  
  531.                    (* enable the irq on the 8259 controller *)
  532.  
  533.          i := Port[I8088_IMR];  (* get the interrupt mask register *)
  534.          m := (1 shl Async_Irq) xor $00FF;
  535.  
  536.          Port[I8088_IMR] := i and m;
  537.  
  538.                    (* enable the data ready interrupt on the 8250 *)
  539.  
  540.          Port[UART_IER + Async_Base] := $01;
  541.  
  542.                    (* enable OUT2 on 8250 *)
  543.  
  544.          i := Port[UART_MCR + Async_Base];
  545.          Port[UART_MCR + Async_Base] := i or $08;
  546.  
  547.  
  548.          Inline($FB); (* enable interrupts *)
  549.  
  550.          Async_Open := TRUE
  551.  
  552.     End;
  553.  
  554. End   (* Async_Open *);
  555.  
  556. (*----------------------------------------------------------------------*)
  557. (*      Async_Carrier_Detect --- Check for modem carrier detect         *)
  558. (*----------------------------------------------------------------------*)
  559.  
  560. Function Async_Carrier_Detect : Boolean;
  561.  
  562. (*                                                                      *)
  563. (*     Function:   Async_Carrier_Detect                                 *)
  564. (*                                                                      *)
  565. (*     Purpose:    Looks for modem carrier detect                       *)
  566. (*                                                                      *)
  567. (*     Calling Sequence:                                                *)
  568. (*                                                                      *)
  569. (*        Flag := Async_Carrier_Detect : Boolean;                       *)
  570. (*                                                                      *)
  571. (*           Flag is set TRUE if carrier detected, else FALSE.          *)
  572. (*                                                                      *)
  573. (*     Calls:  None                                                     *)
  574. (*                                                                      *)
  575.  
  576. Begin (* Async_Carrier_Detect *)
  577.  
  578.    Async_Carrier_Detect := ODD( Port[ UART_MSR + Async_Base ] SHR 7 );
  579.  
  580. End   (* Async_Carrier_Detect *);
  581.  
  582. (*----------------------------------------------------------------------*)
  583. (*      Async_Carrier_Drop --- Check for modem carrier drop/timeout     *)
  584. (*----------------------------------------------------------------------*)
  585.  
  586. Function Async_Carrier_Drop : Boolean;
  587.  
  588. (*                                                                      *)
  589. (*     Function:   Async_Carrier_Drop                                   *)
  590. (*                                                                      *)
  591. (*     Purpose:    Looks for modem carrier drop/timeout                 *)
  592. (*                                                                      *)
  593. (*     Calling Sequence:                                                *)
  594. (*                                                                      *)
  595. (*        Flag := Async_Carrier_Drop : Boolean;                         *)
  596. (*                                                                      *)
  597. (*           Flag is set TRUE if carrier dropped, else FALSE.           *)
  598. (*                                                                      *)
  599. (*     Calls:  None                                                     *)
  600. (*                                                                      *)
  601.  
  602. Begin (* Async_Carrier_Drop *)
  603.  
  604.    Async_Carrier_Drop := NOT ODD( Port[ UART_MSR + Async_Base ] SHR 7 );
  605.  
  606. End   (* Async_Carrier_Drop *);
  607.  
  608. (*----------------------------------------------------------------------*)
  609. (*      Async_Term_Ready --- Set terminal ready status                  *)
  610. (*----------------------------------------------------------------------*)
  611.  
  612. Procedure Async_Term_Ready( Ready_Status : Boolean );
  613.  
  614. (*                                                                      *)
  615. (*     Procedure:  Async_Term_Ready                                     *)
  616. (*                                                                      *)
  617. (*     Purpose:    Sets terminal ready status                           *)
  618. (*                                                                      *)
  619. (*     Calling Sequence:                                                *)
  620. (*                                                                      *)
  621. (*        Async_Term_Ready( Ready_Status : Boolean );                   *)
  622. (*                                                                      *)
  623. (*           Ready_Status --- Set TRUE to set terminal ready on,        *)
  624. (*                            Set FALSE to set terminal ready off.      *)
  625. (*                                                                      *)
  626. (*     Calls:  None                                                     *)
  627. (*                                                                      *)
  628.  
  629. Var
  630.    Mcr_Value: Byte;
  631.  
  632. Begin (* Async_Term_Ready *)
  633.  
  634.    Mcr_Value := Port[ UART_MCR + Async_Base ];
  635.  
  636.    If ODD( Mcr_Value ) Then Mcr_Value := Mcr_Value - 1;
  637.  
  638.    If Ready_Status Then Mcr_Value := Mcr_Value + 1;
  639.  
  640.    Port[ UART_MCR + Async_Base ] := Mcr_Value;
  641.  
  642. End   (* Async_Term_Ready *);
  643.  
  644. (*----------------------------------------------------------------------*)
  645. (*          Async_Buffer_Check --- Check if character in buffer         *)
  646. (*----------------------------------------------------------------------*)
  647.  
  648. Function Async_Buffer_Check : Boolean;
  649.  
  650. (*                                                                      *)
  651. (*     Function:   Async_Buffer_Check                                   *)
  652. (*                                                                      *)
  653. (*     Purpose:    Check if character in buffer                         *)
  654. (*                                                                      *)
  655. (*     Calling Sequence:                                                *)
  656. (*                                                                      *)
  657. (*        Flag := Async_Buffer_Check : Boolean;                         *)
  658. (*                                                                      *)
  659. (*           Flag returned TRUE if character received in buffer,        *)
  660. (*           Flag returned FALSE if no character received.              *)
  661. (*                                                                      *)
  662. (*     Calls:  None                                                     *)
  663. (*                                                                      *)
  664. (*     Remarks:                                                         *)
  665. (*                                                                      *)
  666. (*       This routine only checks if a character has been received      *)
  667. (*       and thus can be read; it does NOT return the character.        *)
  668. (*       Use Async_Receive to read the character.                       *)
  669. (*                                                                      *)
  670.  
  671. Begin   (* Async_Buffer_Check *)
  672.  
  673.    Async_Buffer_Check := ( Async_Buffer_Head <> Async_Buffer_Tail );
  674.  
  675. End     (* Async_Buffer_Check *);
  676.  
  677. (*----------------------------------------------------------------------*)
  678. (*          Async_Receive --- Return character from buffer              *)
  679. (*----------------------------------------------------------------------*)
  680.  
  681. Function Async_Receive( Var C : Char ) : Boolean;
  682.  
  683. (*                                                                      *)
  684. (*     Function:   Async_Receive                                        *)
  685. (*                                                                      *)
  686. (*     Purpose:    Retrieve character (if any) from buffer              *)
  687. (*                                                                      *)
  688. (*     Calling Sequence:                                                *)
  689. (*                                                                      *)
  690. (*        Flag := Async_Receive( Var C: Char ) : Boolean;               *)
  691. (*                                                                      *)
  692. (*           C --- character (if any) retrieved from buffer;            *)
  693. (*                 set to CHR(0) if no character available.             *)
  694. (*                                                                      *)
  695. (*           Flag returned TRUE if character retrieved from buffer,     *)
  696. (*           Flag returned FALSE if no character retrieved.             *)
  697. (*                                                                      *)
  698. (*     Calls:  None                                                     *)
  699. (*                                                                      *)
  700.  
  701. Begin   (* Async_Receive *)
  702.  
  703.    If Async_Buffer_Head = Async_Buffer_Tail Then
  704.       Begin (* No character to retrieve *)
  705.  
  706.          Async_Receive := FALSE;
  707.          C             := CHR( 0 );
  708.  
  709.       End   (* No character available   *)
  710.  
  711.    Else
  712.       Begin (* Character available *)
  713.  
  714.                    (* Turn off interrupts *)
  715.  
  716.          INLINE( $FA );       (* CLI --- Turn off interrupts *)
  717.  
  718.                    (* Get character from buffer *)
  719.  
  720.          C := Async_Buffer[ Async_Buffer_Tail ];
  721.  
  722.                    (* Increment buffer pointer.   If past *)
  723.                    (* end of buffer, reset to beginning.  *)
  724.  
  725.          Async_Buffer_Tail := Async_Buffer_Tail + 1;
  726.  
  727.          If Async_Buffer_Tail > Async_Buffer_Max Then
  728.             Async_Buffer_Tail := 0;
  729.  
  730.                    (* Decrement buffer use count *)
  731.  
  732.          Async_Buffer_Used  := Async_Buffer_Used - 1;
  733.  
  734.                    (* Turn on interrupts *)
  735.  
  736.          INLINE( $FB );       (* STI --- Turn on interrupts *)
  737.  
  738.                    (* Indicate character successfully retrieved *)
  739.  
  740.          Async_Receive := TRUE;
  741.  
  742.       End   (* Character available *);
  743.  
  744. End   (* Async_Receive *);
  745.  
  746. (*----------------------------------------------------------------------*)
  747. (*   Async_Receive_With_TimeOut --- Return char. from buffer with delay *)
  748. (*----------------------------------------------------------------------*)
  749.  
  750. Procedure Async_Receive_With_Timeout( Secs : Integer; Var C : Integer );
  751.  
  752. (*                                                                      *)
  753. (*     Procedure:  Async_Receive_With_Delay                            *)
  754. (*                                                                      *)
  755. (*     Purpose:    Retrieve character as integer from buffer,           *)
  756. (*                 or return TimeOut if specified delay period          *)
  757. (*                 expires.                                             *)
  758. (*                                                                      *)
  759. (*     Calling Sequence:                                                *)
  760. (*                                                                      *)
  761. (*        Async_Receive_With_Timeout( Secs: Integer; Var C: Integer );  *)
  762. (*                                                                      *)
  763. (*           Secs ---  Timeout period in seconds                        *)
  764. (*           C     --- ORD(character) (if any) retrieved from buffer;   *)
  765. (*                     set to TimeOut if no character found before      *)
  766. (*                     delay period expires.                            *)
  767. (*                                                                      *)
  768. (*     Calls:  Async_Receive                                            *)
  769. (*                                                                      *)
  770. (*     WATCH OUT!  THIS ROUTINE RETURNS AN INTEGER, NOT A CHARACTER!!!  *)
  771. (*                                                                      *)
  772. (*     Note:  This routine uses a CPU loop to do timing.  The value of  *)
  773. (*            the constant used is suitable for 4.77 MHz CPUs.  If your *)
  774. (*            CPU is faster or slower, you will need to adjust the      *)
  775. (*            value of ASYNC_LOOPS_PER_SEC.                             *)
  776. (*                                                                      *)
  777.  
  778. Var
  779.    Isecs        : Integer;
  780.    Jsecs        : Integer;
  781.    I            : Integer;
  782.    J            : Integer;
  783.    Char_Waiting : Boolean;
  784.    Ch           : Char;
  785.  
  786. Begin (* Async_Receive_With_Timeout *)
  787.  
  788.    I     := Maxint DIV Async_Loops_Per_Sec;
  789.    Isecs := ( Secs + I - 1 ) DIV I;
  790.    Jsecs := ( Secs - Isecs * ( I - 1 ) ) * Async_Loops_Per_Sec;
  791.    Isecs := Isecs + 1;
  792.  
  793.    Repeat
  794.       J := Jsecs;
  795.       Repeat
  796.          J            := J - 1;
  797.          Char_Waiting := ( Async_Buffer_Head <> Async_Buffer_Tail );
  798.       Until( ( J = 0 ) OR ( Char_Waiting ) );
  799.       Isecs  := Isecs - 1;
  800.    Until( ( Isecs = 0 ) OR ( Char_Waiting ) );
  801.  
  802.    If ( NOT Char_Waiting) Then
  803.       C := TimeOut
  804.    Else
  805.       Begin
  806.          Char_Waiting := Async_Receive( Ch );
  807.          C := ORD( Ch );
  808.       End;
  809.  
  810. End   (* Async_Receive_With_Timeout *);
  811.  
  812. (*----------------------------------------------------------------------*)
  813. (*          Async_Send --- Send character over communications port      *)
  814. (*----------------------------------------------------------------------*)
  815.  
  816. Procedure Async_Send( C : Char );
  817.  
  818. (*                                                                      *)
  819. (*     Procedure:  Async_Send                                           *)
  820. (*                                                                      *)
  821. (*     Purpose:    Sends character out over communications port         *)
  822. (*                                                                      *)
  823. (*     Calling Sequence:                                                *)
  824. (*                                                                      *)
  825. (*        Async_Send( C : Char );                                       *)
  826. (*                                                                      *)
  827. (*           C --- Character to send                                    *)
  828. (*                                                                      *)
  829. (*     Calls:  None                                                     *)
  830. (*                                                                      *)
  831.  
  832. Var
  833.    i       : Integer;
  834.    m       : Integer;
  835.    Counter : Integer;
  836.  
  837. Begin   (* Async_Send *)
  838.  
  839.                    (* Turn on OUT2, DTR, and RTS *)
  840.  
  841.    Port[UART_MCR + Async_Base] := $0B;
  842.  
  843.                    (* Wait for CTS using Busy Wait *)
  844.  
  845.    Counter := MaxInt;
  846.  
  847.    While ( Counter <> 0 ) AND
  848.          ( ( Port[UART_MSR + Async_Base] AND $10 ) = 0 ) Do
  849.       Counter := Counter - 1;
  850.  
  851.                    (* Wait for Transmit Hold Register Empty (THRE) *)
  852.  
  853.    If Counter <> 0 Then Counter := MaxInt;
  854.  
  855.    While ( Counter <> 0 ) AND
  856.          ( ( Port[UART_LSR + Async_Base] AND $20 ) = 0 ) Do
  857.       Counter := Counter - 1;
  858.  
  859.                    (* Send the character if port clear *)
  860.  
  861.   If Counter <> 0 Then
  862.      Begin  (* Send the Character *)
  863.  
  864.         Inline($FA); (* CLI --- disable interrupts *)
  865.  
  866.         Port[UART_THR + Async_Base] := Ord(C);
  867.  
  868.         Inline($FB); (* STI --- enable interrupts *)
  869.  
  870.      End    (* Send the Character *)
  871.  
  872.   Else  (* Timed Out *)
  873.      Writeln('<<<TIMEOUT>>>');
  874.  
  875. End    (* Async_Send *);
  876.  
  877. (*----------------------------------------------------------------------*)
  878. (*          Async_Send_Break --- Send break (attention) signal          *)
  879. (*----------------------------------------------------------------------*)
  880.  
  881. Procedure Async_Send_Break;
  882.  
  883. (*                                                                      *)
  884. (*     Procedure:  Async_Send_Break                                     *)
  885. (*                                                                      *)
  886. (*     Purpose:    Sends break signal over communications port          *)
  887. (*                                                                      *)
  888. (*     Calling Sequence:                                                *)
  889. (*                                                                      *)
  890. (*        Async_Send_Break;                                             *)
  891. (*                                                                      *)
  892. (*     Calls:  None                                                     *)
  893. (*                                                                      *)
  894.  
  895. Var
  896.    Old_Lcr   : Byte;
  897.    Break_Lcr : Byte;
  898.  
  899. Begin (* Async_Send_Break *)
  900.  
  901.    Old_Lcr   := Port[ UART_LCR + Async_Base ];
  902.    Break_Lcr := Old_Lcr;
  903.  
  904.    If Break_Lcr >  127 Then Break_Lcr := Break_Lcr - 128;
  905.    If Break_Lcr <=  63 Then Break_Lcr := Break_Lcr +  64;
  906.  
  907.    Port[ UART_LCR + Async_Base ] := Break_Lcr;
  908.  
  909.    Delay( 400 );
  910.  
  911.    Port[ UART_LCR + Async_Base ] := Old_Lcr;
  912.  
  913. End   (* Async_Send_Break *);
  914.  
  915. (*----------------------------------------------------------------------*)
  916. (*     Async_Send_String --- Send string over communications port       *)
  917. (*----------------------------------------------------------------------*)
  918.  
  919. Procedure Async_Send_String( S : AnyStr );
  920.  
  921. (*                                                                      *)
  922. (*     Procedure:  Async_Send_String                                    *)
  923. (*                                                                      *)
  924. (*     Purpose:    Sends string out over communications port            *)
  925. (*                                                                      *)
  926. (*     Calling Sequence:                                                *)
  927. (*                                                                      *)
  928. (*        Async_Send_String( S : AnyStr );                              *)
  929. (*                                                                      *)
  930. (*           S --- String to send                                       *)
  931. (*                                                                      *)
  932. (*     Calls:  Async_Send                                               *)
  933. (*                                                                      *)
  934.  
  935. Var
  936.    i : Integer;
  937.  
  938. Begin  (* Async_Send_String *)
  939.  
  940.   For i := 1 To LENGTH( S ) Do
  941.      Async_Send( S[i] )
  942.  
  943. End    (* Async_Send_String *);
  944.  
  945. (*----------------------------------------------------------------------*)
  946. (*     Async_Send_String_With_Delays --- Send string with timed delays  *)
  947. (*----------------------------------------------------------------------*)
  948.  
  949. Procedure Async_Send_String_With_Delays( S          : AnyStr;
  950.                                          Char_Delay : Integer;
  951.                                          EOS_Delay  : Integer  );
  952.  
  953. (*                                                                      *)
  954. (*     Procedure:  Async_Send_String_With_Delays                        *)
  955. (*                                                                      *)
  956. (*     Purpose:    Sends string out over communications port with       *)
  957. (*                 specified delays for each character and at the       *)
  958. (*                 end of the string.                                   *)
  959. (*                                                                      *)
  960. (*     Calling Sequence:                                                *)
  961. (*                                                                      *)
  962. (*        Async_Send_String_With_Delays( S          : AnyStr ;          *)
  963. (*                                       Char_Delay : Integer;          *)
  964. (*                                       EOS_Delay  : Integer );        *)
  965. (*                                                                      *)
  966. (*           S          --- String to send                              *)
  967. (*           Char_Delay --- Number of milliseconds to delay after       *)
  968. (*                          sending each character                      *)
  969. (*           EOS_Delay  --- Number of milleseconds to delay after       *)
  970. (*                          sending last character in string            *)
  971. (*                                                                      *)
  972. (*     Calls:  Async_Send                                               *)
  973. (*             Async_Send_String                                        *)
  974. (*             Length                                                   *)
  975. (*             Delay                                                    *)
  976. (*                                                                      *)
  977. (*     Remarks:                                                         *)
  978. (*                                                                      *)
  979. (*        This routine is useful when writing routines to perform       *)
  980. (*        non-protocol uploads.  Many computer systems require delays   *)
  981. (*        between receipt of characters for correct processing.  The    *)
  982. (*        delay for end-of-string usually applies when the string       *)
  983. (*        represents an entire line of a file.                          *)
  984. (*                                                                      *)
  985. (*        If delays are not required, Async_Send_String is faster.      *)
  986. (*        This routine will call Async_Send_String is no character      *)
  987. (*        delay is to be done.                                          *)
  988. (*                                                                      *)
  989.  
  990. Var
  991.    I : Integer;
  992.  
  993. Begin  (* Async_Send_String_With_Delays *)
  994.  
  995.    If Char_Delay <= 0 Then
  996.       Async_Send_String( S )
  997.    Else
  998.       For I := 1 To LENGTH( S ) Do
  999.          Begin
  1000.             Async_Send( S[I] );
  1001.             Delay( Char_Delay );
  1002.          End;
  1003.  
  1004.    If EOS_Delay > 0 Then Delay( EOS_Delay );
  1005.  
  1006. End    (* Async_Send_String_With_Delays *);
  1007.  
  1008. (*----------------------------------------------------------------------*)
  1009. (*      Async_Percentage_Used --- Report Percentage Buffer Filled       *)
  1010. (*----------------------------------------------------------------------*)
  1011.  
  1012. Function Async_Percentage_Used : Real;
  1013.  
  1014. (*                                                                      *)
  1015. (*     Function:   Async_Percent_Used                                   *)
  1016. (*                                                                      *)
  1017. (*     Purpose:    Reports percentage of com buffer currently filled    *)
  1018. (*                                                                      *)
  1019. (*     Calling Sequence:                                                *)
  1020. (*                                                                      *)
  1021. (*        Percentage := Async_Percentage_Used : Real;                   *)
  1022. (*                                                                      *)
  1023. (*           Percentage gets how much of buffer is filled;              *)
  1024. (*           value goes from 0.0 (empty) to 1.0 (totally full).         *)
  1025. (*                                                                      *)
  1026. (*     Calls:  None                                                     *)
  1027. (*                                                                      *)
  1028. (*     Remarks:                                                         *)
  1029. (*                                                                      *)
  1030. (*       This routine is helpful when incorporating handshaking into    *)
  1031. (*       a communications program.  For example, assume that the host   *)
  1032. (*       computer uses the XON/XOFF (DC1/DC3) protocol.  Then the       *)
  1033. (*       PC program should issue an XOFF  to the host when the value    *)
  1034. (*       returned by Async_Percentage_Used > .75 or so.  When the       *)
  1035. (*       utilization percentage drops below .25 or so, the PC program   *)
  1036. (*       should transmit an XON.                                        *)
  1037. (*                                                                      *)
  1038.  
  1039. Begin (* Async_Percentage_Used *)
  1040.  
  1041.    Async_Percentage_Used := Async_Buffer_Used / ( Async_Buffer_Max + 1 );
  1042.  
  1043. End   (* Async_Percentage_Used *);
  1044.  
  1045. (*----------------------------------------------------------------------*)
  1046. (*     Async_Purge_Buffer --- Purge communications input buffer         *)
  1047. (*----------------------------------------------------------------------*)
  1048.  
  1049. Procedure Async_Purge_Buffer;
  1050.  
  1051. (*                                                                      *)
  1052. (*     Procedure:  Async_Purge_Buffer                                   *)
  1053. (*                                                                      *)
  1054. (*     Purpose:    Purges communications input buffer                   *)
  1055. (*                                                                      *)
  1056. (*     Calling Sequence:                                                *)
  1057. (*                                                                      *)
  1058. (*        Async_Purge_Buffer;                                           *)
  1059. (*                                                                      *)
  1060. (*     Calls:  Async_Receive                                            *)
  1061. (*                                                                      *)
  1062.  
  1063. Var
  1064.    C: Char;
  1065.  
  1066. Begin  (* Async_Purge_Buffer *)
  1067.  
  1068.    Repeat
  1069.       Delay( 35 );
  1070.    Until ( NOT Async_Receive( C ) );
  1071.  
  1072. End    (* Async_Purge_Buffer *);
  1073.